home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
batchut
/
rap101.zip
/
COMMON.RAP
< prev
next >
Wrap
Text File
|
1989-05-10
|
20KB
|
818 lines
; common.rap v1.01 compacted version - copyright 1988 SIL - 10 May 1989
#verbose=1
if ($screentype == "Sharp LCD")
$skip=$null
else
$skip=$newline*chr(13)
endif
$valdr=*getdr__()
#help__= -1
$helpfile__=
$dospath__=$path
proc error($message,$topic)
declare $tag,$indent
declare $left,$match,$right
if (not ($message contains "[.!?]$"))
$message=$message.
endif
if ($message contains "^[ \\t][ \\t]*")
$indent=$match
endif
t:$skip*chr(7)$message\
if ($topic == "")
$tag=Try again.
else
$tag=Try again. (Type ? for help.)
endif
if ((*strlen($message) + *strlen($tag)) > 72)
t:
t:$indent\
else
t: \
endif
t:$tag
endproc
proc warning($message)
if (not $message has "\\.?!$")
$message=$message.
endif
t:$skip*chr(7)$message.
kbflush()
foot
endproc
proc mount_volume($drive,$id,$name,$topic)
declare $volname,#fd,#case,#opentest,#reopen_help
loop
$volname=*volume($drive)
exit if ($volname == $id)
if (not #opentest)
#opentest = 1
#fd = *open("nul")
close #fd
if (#fd > 1 or (#fd > 0 and #help__ == -1))
t:*chr(7)
t:The program needs to change disks so that the $name
t:disk is accessible, but it is not safe to do so because the program has
t:one or more files open.
t:
if ($topic <> "")
explain($topic)
else
t: The program must terminate immediately. Please report this
t: message to the program's author.
endif
foot
bye
endif
endif
if (#help__ >= 0)
close #help__
#help__ = -1
#reopen_help = 1
endif
t:$skip\Put the $name disk in drive $drive.
kbflush()
foot:Press RETURN after you have done this.
endloop
if (#reopen_help)
reopen_help__()
endif
endproc
proc panic__($location,$msg)
declare #paged
t:*chr(7)$skip\Internal error in \*$location:
t:
t: $msg
t:
t:The program will continue to run, but the results may not be valid.
t:Copy this message exactly, so you can report it to the program's author,
t:and exit as soon as possible. You may exit immediately by typing
t:Ctrl-C.
kbflush()
foot
endproc
proc kbflush()
declare $junk
loop while (*keypress())
as $junk
endloop
endproc
strfunc getdr__()
declare $drvlist,$tmp,#case,#tmp
declare $left,$match,$right
if ($cmdline contains "[-/]drive=[ \\t]*")
$drvlist=$right
if ($drvlist contains "[ \\t]")
$drvlist=$left
endif
return $drvlist
endif
if ($screentype == "Sharp LCD")
if (*freesp("P") == -1)
return "ABCDG"
else
return "ABCDGP"
endif
else
$drvlist=AB
$tmp=C
loop while (*freesp($tmp) > 0)
$drvlist=$drvlist$tmp
#tmp = *ascii($tmp) + 1
$tmp=*chr(#tmp)
endloop
return $drvlist
endif
endfunc
proc explain($topic)
declare #case,$line
declare $left,$match,$right
if (not #verbose)
return
else if (#help__ < 0)
t:There is no help-file available to this program.
foot
return
endif
seek #help__,2
loop while ($line <> "End of file.")
read #help__,$line
exit if (not ($line contains ":"))
exit if ($left == $topic)
endloop
if ($line == "End of file." or $left <> $topic)
t:Sorry, there is no information on <$topic> in the help file.
foot
return
endif
seek #help__,*value($right),bytes
loop
read #help__,$line
exit if ($line == "End of file.")
if (not ($line has "^\\\\"))
t:$line
else if ($line=="\\cls")
cls
else if ($line=="\\foot")
foot
else if ($line has "^\\\\topic[ \\t]")
exit
else
t:$line
endif
endloop
endproc
strfunc get_filespec($query,$defpath,$defname,$defext,$topic)
declare $answer,$left,$match,$right,#case,$default,$defdrive
$drive=
$subdir=
$name=
$ext=
$defext=*ensure_dot($defext)
if ($defpath <> "")
if (not ($defpath has "[:\\\\]$"))
$defpath=$defpath\\
endif
endif
$default=$defname$defext
if ($default <> "")
$query=$query [$default]
endif
loop
$answer=*get_ans("$query (type DIR for directory):","",$topic,not +
*strlen($default))
if (($answer == "") and ($default == $defext))
error(" Your answer must always include a filename part.",$topic)
repeat
else if ($answer == "")
$answer=$defpath$defname$defext
else if ($answer contains "^[ \\t]*dir\[ \\t]*")
show_dir__($right,$defpath,$defext)
repeat
endif
if (not ($answer has "[\\\\:]"))
$answer=$defpath$answer
endif
if (*parse_filespec($answer,1,$topic))
if ($ext == "")
$ext=$defext
endif
return "$drive$subdir$name$ext"
endif
endloop
endfunc
strfunc get_input_file($query,$defpath,$defname,$defext,$topic)
declare #case,#verbose,$filespec
declare $oldname
#verbose=1
loop
$filespec=*get_filespec($query,$defpath,$defname,$defext,$topic)
#filesize=*filesize($filespec)
if (#filesize < 0)
error(" $filespec does not exist.",$topic)
else
#filesize=(#filesize+1023)/1024
if (($ext == ".TMP") or ($ext == ".BAK"))
t:*chr(7)An input file may not have a TMP or BAK extension.
repeat if (*no("Do you want to rename the file to a different+
extension","",""))
$oldname=$filespec
loop
$ext=*get_str("New extension for $oldname","","",1,4,1)
$ext=*ensure_dot($ext)
$filespec=$drive$subdir$name$ext
if (not *val_ext($ext,$topic))
repeat
else if (($ext == ".TMP") or ($ext == ".BAK"))
error(" You must rename the extension to something besides TMP or BAK.",$topic)
else if (not *existf($filespec))
exit
endif
t:*chr(7)$filespec already exists. Try a different extension.
endloop
xs ren $oldname $name$ext
endif
return $filespec
endif
endloop
endfunc
strfunc get_output_file($query,$defpath,$defname,$defext,$topic,#size)
declare $filespec,#case
loop
$filespec=*get_filespec($query,$defpath,$defname,$defext,$topic)
if (*delq($filespec) <> 4)
ensure_space($drive,$subdir,#size)
return $filespec
endif
endloop
endfunc
proc ensure_space($dr,$subdir,#size)
declare #need
declare $spare
declare $delname
declare $path
declare $name,$ext
declare $drive
declare #attr
if (#size < 1)
return
else if ($dr == "")
$dr=*currdriv():
else
$dr=*to_upper("*mid($dr,1,1)"):
endif
loop
#need=#size-(*freesp($dr)/1024)
exit if (#need < -10)
if (#need > 0)
t:*chr(7)\
t:
t:There is not enough space for the output file on drive $dr.
t:You need to reclaim at least #need\K of space before proceeding.
else
if (#need == 0)
$spare=absolutely no space
else
#need = (0 - #need)
$spare=only #need\K
endif
t:*chr(7)\
t:
t:Your output file will probably fit on drive $dr, but there is
t:$spare to spare. If there is a possibility that the output file
t:will grow, it would be wise to make some extra space for the +
output file.
exit if (*no("Do you want to pause to delete some files","y",""))
endif
xs dir $dr$subdir /w /p
get_filespec("File to delete","$dr$subdir","","","")
if (*to_upper($dr) <> *to_upper($drive))
error(" You must delete files on drive *to_upper($dr).","")
else
$delname=$dr$subdir$name$ext
#attr = *deletef($delname)
if (#attr == 0)
t:File $delname not found.
else if (#attr == 4)
t:File $delname is read-only and can't be deleted.
endif
endif
endloop
endproc
strfunc make_tmp_output($file,#size)
declare $left,$right,$match,#case,$path
declare $drive
if ($file contains "\\.[^\\.\\\\]*$")
$file=$left.TMP
else
$file=$file.TMP
endif
if ($file contains ":")
$drive=$left
else
$drive=
endif
if (*deletef($file) == 4)
panic__("make_tmp_output","Need to delete $file but it's read-only")
endif
ensure_space($drive,"",#size)
return $file
endfunc
proc make_bak_file($oldname,$tmpname)
declare $left,$match,$right,#case
declare $bak
if ($oldname contains "\\.[^\\.\\\\]*$")
$bak=$left.BAK
else
$bak=$oldname.BAK
endif
if (*deletef($bak) == 4)
panic__("make_bak_file","need to delete $bak but it's read-only")
else
xs ren $oldname *.BAK
if ($oldname contains "[^:\\\\]*$")
xs ren $tmpname $match
else
warning("Couldn't rename $tmpname to $oldname")
endif
endif
endproc
proc make_bak_to_bat($oldname,$tmpname,#bat)
declare $left,$match,$right,#case
declare $bak
if ($oldname contains "\\.[^\\.\\\\]*$")
$bak=$left.BAK
else
$bak=$oldname.BAK
endif
wr #bat,if exist $bak del $bak
wr #bat,if exist $oldname ren $oldname *.bak
if ($oldname contains "[^:\\\\]*$")
wr #bat,if exist $tmpname ren $tmpname $match
else
warning("Couldn't rename $tmpname to $oldname")
endif
endproc
strfunc ensure_dot($ext)
if ($ext <> "")
i